Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d1/go2.arc/GO.BAS

BASIC Source File | 1989-07-21 | 6KB | 255 lines

'$INCLUDE: 'QB.BI'

DEFINT A-Z

TYPE DTAType
    reserved  AS STRING * 21
    attrib    AS STRING * 1
    WriteTime AS INTEGER
    WriteDate AS INTEGER
    Size      AS LONG
    FileName  AS STRING * 13
END TYPE

DECLARE SUB ParseCommandLine ()
DECLARE SUB Help ()
DECLARE SUB Done ()
DECLARE SUB TestDir ()
DECLARE FUNCTION GetDrive% ()
DECLARE SUB SetDrive (Drive%)
DECLARE FUNCTION GetCurrDir$ ()
DECLARE FUNCTION DOSFindFirst% (Spec$, attrib%)
DECLARE FUNCTION DOSFindNext% ()
DECLARE SUB SetDTA (DTA AS DTAType)

CONST FALSE = 0
CONST TRUE = NOT FALSE

CLEAR , , 3000

DIM SHARED FileSearch, DirSearch
DIM SHARED OrigDrive, OrigDir$
DIM SHARED SearchDrive
DIM SHARED DIRSearchString$, DIRSearchLength
DIM SHARED FileSearchString$
DIM SHARED ResetDrive, ResetDir
DIM SHARED ParamCount, Param$(10)
DIM SHARED InRegs AS RegType, OutRegs AS RegType
DIM SHARED InRegsX AS RegTypeX, OutRegsX AS RegTypeX

FileSearch = TRUE
DirSearch = TRUE

ResetDrive = FALSE
ResetDir = FALSE

CONST NORMAL = 0
CONST SUBDIR = &H10

'++++++++++++++++++++++++++++++++++++
'  Program begins here
'++++++++++++++++++++++++++++++++++++

ParseCommandLine
IF ParamCount < 1 OR ParamCount > 2 THEN
    Help
    END
END IF

OrigDrive = GetDrive
OrigDir$ = GetCurrDir$

IF ParamCount = 2 THEN
    IF Param$(2) = "-F" OR Param$(2) = "/F" THEN
        DirSearch = FALSE
    ELSE
        Help
    END IF
END IF

SearchString$ = Param$(1)

IF MID$(SearchString$, 2, 1) = ":" THEN
    NewDrive = ASC(LEFT$(SearchString$, 1)) - ASC("A")
    SetDrive (NewDrive)
    ResetDrive = TRUE
    SearchString$ = MID$(SearchString$, 3)
END IF

IF LEFT$(SearchString$, 1) = "\" THEN
    SearchString$ = MID$(SearchString$, 2)
    FileSearch = FALSE
END IF

IF INSTR(SearchString$, "?") OR INSTR(SearchString$, "*") THEN
    DirSearch = FALSE
END IF

IF DirSearch THEN
    DIRSearchString$ = SearchString$
    DIRSearchLength = LEN(DIRSearchString$)
END IF

IF FileSearch THEN
    FileSearchString$ = SearchString$
    IF INSTR(FileSearchString$, ".") = 0 THEN
        FileSearchString$ = FileSearchString$ + ".*"
    END IF
END IF

IF DirSearch OR FileSearch THEN
    CHDIR ("\")
    TestDir
    ResetDir = TRUE
    Done
ELSE
    Help
END IF
END

SUB ParseCommandLine
    temp$ = LTRIM$(RTRIM$(UCASE$(COMMAND$))) + " "
    ParamCount = 0
    DO WHILE LEN(temp$) > 1
        ParamCount = ParamCount + 1
        Param$(ParamCount) = LEFT$(temp$, INSTR(temp$, " ") - 1)
        temp$ = MID$(temp$, INSTR(temp$, " ") + 1)
    LOOP
END SUB

SUB Help
    PRINT "GO moves you quickly from one subdirectory to another"
    PRINT "Syntax:"
    PRINT "       GO [d:][\]pathname [-F]"
    PRINT "          the pathname can be either the name of a directory or"
    PRINT "          the name of a file.  It may contain wild cards."
    PRINT
    PRINT "          If 'd:' is included, drive 'd:' will be used instead"
    PRINT "          of the current default drive."
    PRINT
    PRINT "          If '\' is included at the beginning of the pathname,"
    PRINT "          only subdirectory names will be searched."
    PRINT
    PRINT "          If '-F' or '/F' is included, or if pathname includes"
    PRINT "          wild card symbols, only file names will be searched."
    PRINT
    PRINT "          Normally, both file names and subdirectory names are"
    PRINT "          searched to match the specified pathname."
    PRINT
    END
END SUB

SUB Done
    IF ResetDir THEN
        PRINT "   Requested subdirectory not found" + CHR$(7)
        CHDIR (OrigDir$)
    ELSE
        PRINT "   New Directory: "; GetCurrDir$
    END IF

    IF ResetDrive THEN
        SetDrive (OrigDrive)
    END IF
    END
END SUB

SUB TestDir
    DIM LocalDTA AS DTAType
    CALL SetDTA(LocalDTA)

    CurrentDir$ = GetCurrDir$
    IF DirSearch AND LEN(CurrentDir$) >= DIRSearchLength THEN
        IF RIGHT$(CurrentDir$, DIRSearchLength) = DIRSearchString$ THEN
            Done
        END IF
    END IF

    IF FileSearch THEN
        IF DOSFindFirst(FileSearchString$, NORMAL) THEN
            Done
        END IF
    END IF

    IF DOSFindFirst("*.*", SUBDIR) THEN
        IF LocalDTA.attrib$ = CHR$(SUBDIR) AND LEFT$(LocalDTA.FileName$, 1) <> "." THEN
            CHDIR (LocalDTA.FileName$)
            TestDir
            CALL SetDTA(LocalDTA)
            CHDIR (CurrentDir$)
        END IF

        DO WHILE DOSFindNext
            IF LocalDTA.attrib$ = CHR$(SUBDIR) AND LEFT$(LocalDTA.FileName$, 1) <> "." THEN
                CHDIR (LocalDTA.FileName$)
                TestDir
                CALL SetDTA(LocalDTA)
                CHDIR (CurrentDir$)
            END IF
        LOOP
    END IF
END SUB

'++++++++++++++++++++++++++++++++++++
'  DOS Interface Functions
'++++++++++++++++++++++++++++++++++++

FUNCTION DOSFindFirst (Spec$, attrib%)
        ' Calls DOS to find directory entry with attribute attrib%
        ' and file name matching Spec$.  Returns TRUE if entry is
        ' found, else returns FALSE
    temp$ = Spec$ + CHR$(0)
    InRegsX.ax = &H4E00
    InRegsX.cx = attrib
    InRegsX.ds = VARSEG(temp$)
    InRegsX.dx = SADD(temp$)
    CALL INTERRUPTX(&H21, InRegsX, OutRegsX)
    DOSFindFirst = ((OutRegsX.flags AND &H1) = 0)
END FUNCTION

FUNCTION DOSFindNext
        'Calls DOS to see if there is another entry that meets the
        'last specification sent to DOSFindFirst.  If so, returns TRUE;
        'else returns FALSE
    InRegs.ax = &H4F00
    CALL INTERRUPT(&H21, InRegs, OutRegs)
    DOSFindNext = ((OutRegs.flags AND &H1) = 0)
END FUNCTION

FUNCTION GetCurrDir$
        ' Calls DOS to get the name of the current default subdirectory.
        ' Returns the directory as a string in the form  \name.....
        ' so that the same string can be used with CHDIR
    DIM temp AS STRING * 64
    InRegsX.ax = &H4700
    InRegsX.dx = 0
    InRegsX.ds = VARSEG(temp$)
    InRegsX.si = VARPTR(temp$)
    CALL INTERRUPTX(&H21, InRegsX, OutRegsX)
    GetCurrDir$ = "\" + LEFT$(temp$, INSTR(temp$, CHR$(0)) - 1)
END FUNCTION

FUNCTION GetDrive%
        'Calls DOS to get current drive letter.  Returns drive as
        'an integer (A = 0, B = 1, etc.)
    InRegs.ax = &H1900
    CALL INTERRUPT(&H21, InRegs, OutRegs)
    GetDrive = OutRegs.ax AND 255
END FUNCTION

SUB SetDrive (Drive)
        ' Calls DOS to change the current default drive
    InRegs.ax = &HE00
    InRegs.dx = Drive
    CALL INTERRUPT(&H21, InRegs, OutRegs)
END SUB

SUB SetDTA (DTA AS DTAType)
        ' Calls DOS to set the current disk transfer area (DTA) for use
        ' by DOSFindFirst and DOSFindNext
    InRegsX.ax = &H1A00
    InRegsX.ds = VARSEG(DTA)
    InRegsX.dx = VARPTR(DTA)
    CALL INTERRUPTX(&H21, InRegsX, OutRegsX)
END SUB